home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PAS_0793 / VS-DEMO.PAS < prev    next >
Pascal/Delphi Source File  |  1993-07-30  |  8KB  |  215 lines
  1. {─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
  2. Msg  : 249 of 278                                                               
  3. From : Liam Stitt                          1:134/21.0           14 Jul 93  11:55 
  4. To   : Digant Kasundra                                                           
  5. Subj : virtual screens                                                        
  6. ────────────────────────────────────────────────────────────────────────────────
  7. Live Long and Prosper, Digant! On 07-13-93  07:15 you scribbled about Re:
  8. virtual screens
  9.  
  10. FYI, I left the demo as it was.
  11.  
  12. ___--VS-DEMO.PAS 1 of 1 - demo for VScreen.TPU------}
  13.  
  14.  
  15. program TestVirtualScreenUnit;
  16. uses
  17.   Dos, Crt,
  18.   Vscreen;         (* VirtualScreen Unit                            *)
  19.  
  20. const
  21.   Screen1 : VsPtr = Nil; (* Message Pad                             *)
  22.   Screen2 : VsPtr = Nil; (* Attr-chart                              *)
  23.   Screen3 : VsPtr = Nil; (* Main display Vscreen                    *)
  24.   Screen4 : VsPtr = Nil; (* Buffer Vscreen                          *)
  25. var
  26.   DUD          : char; (* "Press <ANY KEY>" character               *)
  27.   Loop1, Loop2 : word;
  28.  
  29.   procedure BuildAttrChart;
  30.   begin
  31.     ClrVscr(Screen2, $37);
  32.     VSetVsXYattr(Screen2, 16, 15, 9, $0F);
  33.     VwriteStringVs(Screen2, '0123456789ABCDEF', 16, 9, $0F);
  34.     VSetVsXYattr(Screen2, 16, 17, 9, $0F);
  35.     VwriteStringVs(Screen2, 'FIRST NUMBER', 9, 11, $3F);
  36.     VwriteStringVs(Screen2, 'BACKGROUND COLOR', 12, 9, $3F);
  37.     WriteStringVs(Screen2, 'SECOND NUMBER = TEXT COLOR', false, 29, 5, $3F);
  38.     WriteStringVs(Screen2,
  39.                   ' 0  1  2  3  4  5  6  7  8  9  A  B  C  D  E  F ',
  40.                   false, 20, 7, $0F);
  41.     for Loop1 := 0 to 15 do
  42.       for Loop2 := 0 to 15 do
  43.         WriteStringVs(Screen2, ' X ', false, (20 + (Loop2 * 3)),
  44.                       (9 + Loop1), (Loop2 + (Loop1 Shl 4)));
  45.   end;
  46.  
  47.   procedure BuildMessages1;
  48.   begin
  49.     ClrVscr(Screen1, $7F);
  50.                              (* Message 1                             *)
  51.     SetVsWindowAttr(Screen1, 1, 47, 11, 20, $17);
  52.     WriteStringVs(Screen1, 'SIMPLE TEST PROGRAM FOR VSCREEN UNIT',
  53.                   false, 6, 13, $1F);
  54.     WriteStringVs(Screen1, 'Every screen you see in this',
  55.                   false, 8, 15, $17);
  56.     WriteStringVs(Screen1, 'program has been pre-built in RAM.',
  57.                   false, 8, 16, $17);
  58.     WriteStringVs(Screen1, 'Press <ENTER> to continue:',
  59.                   false, 12, 18, $17);
  60.     SetVsXYattr(Screen1, 7, 7, 15, $0F);
  61.                              (* Message 2                             *)
  62.     WriteStringVs(Screen1, 'SO WHAT DOES IT DO????',
  63.                   false, 13, 3, $7F);
  64.     WriteStringVs(Screen1, 'This program will show how screen-',
  65.                   false, 8, 5, $7F);
  66.     WriteStringVs(Screen1, 'attributes are set hexidecimally.',
  67.                   false, 8, 6, $7F);
  68.     WriteStringVs(Screen1, 'Press <ENTER> to continue:',
  69.                   false, 12, 8, $7F);
  70.   end;
  71.  
  72.   procedure BuildMessages2;
  73.   begin
  74.     ClrVscr(Screen1, $70);
  75.                              (* Message 3                             *)
  76.     WriteStringVs(Screen1, 'Underneath this window is a hexidecimal',
  77.                   false, 3, 3, $70);
  78.     WriteStringVs(Screen1, 'color attribute chart. To determine the',
  79.                   false, 3, 4, $70);
  80.     WriteStringVs(Screen1, 'hexidecimal attribute for the color you',
  81.                   false, 3, 5, $70);
  82.     WriteStringVs(Screen1, 'want, just...',
  83.                   false, 3, 6, $70);
  84.     WriteStringVs(Screen1, 'Press <ENTER> to continue:',
  85.                   false, 9, 8, $7F);
  86.                              (* Message 4                             *)
  87.     WriteStringVs(Screen1, 'Look-up the background color',
  88.                   false, 3, 13, $70);
  89.     WriteStringVs(Screen1, 'from this collumn. This is',
  90.                   false, 3, 14, $70);
  91.     WriteStringVs(Screen1, 'the first digit of the Hex-',
  92.                   false, 3, 15, $70);
  93.     WriteStringVs(Screen1, 'attribute. Green is number 2',
  94.                   false, 3, 16, $70);
  95.     WriteStringVs(Screen1, 'Press <ENTER> to continue:',
  96.                   false, 4, 18, $7F);
  97.                              (* Message 5                             *)
  98.     WriteStringVs(Screen1, 'Next, look-up the text color',
  99.                   false, 33, 13, $70);
  100.     WriteStringVs(Screen1, 'from this row. White is',
  101.                   false, 33, 14, $70);
  102.     WriteStringVs(Screen1, 'number F. This is the second',
  103.                   false, 33, 15, $70);
  104.     WriteStringVs(Screen1, 'digit of the Hex-attribute.',
  105.                   false, 33, 16, $70);
  106.     WriteStringVs(Screen1, 'Press <ENTER> to continue:',
  107.                   false, 34, 18, $7F);
  108.   end;
  109.  
  110.   procedure BuildMessages3;
  111.   begin
  112.     ClrVscr(Screen1, $70);
  113.                              (* Message 6                             *)
  114.     WriteStringVs(Screen1, 'So the two hex-numbers combined',
  115.                   false, 3, 3, $70);
  116.     WriteStringVs(Screen1, 'equal 2F hexidecimal. Which is',
  117.                   false, 3, 4, $70);
  118.     WriteStringVs(Screen1, 'white text on a green background',
  119.                   false, 3, 5, $70);
  120.     WriteStringVs(Screen1, 'Here''s the full chart:',
  121.                   false, 3, 6, $70);
  122.     WriteStringVs(Screen1, 'Press <ENTER> to continue:',
  123.                   false, 6, 8, $7F);
  124.   end;
  125.                  (* The following procedure ONLY works for EGA+ modes *)
  126.   procedure  Blink(BlinkOn : boolean);
  127.   var
  128.     Regs : registers;
  129.   begin
  130.     with Regs do
  131.       begin
  132.         AX := $1003;
  133.         BX := Ord(BlinkOn);
  134.       end;
  135.     Intr($10, Regs)
  136.   end;
  137.  
  138. BEGIN
  139.   if NOT ColorMode then
  140.     begin
  141.       WriteLn(' This demo can only be run in color-text mode');
  142.       Halt(1);
  143.     end;
  144.   VsInit(Screen1);  (* Allocate VirtualScreens on the Heap            *)
  145.   VsInit(Screen2);
  146.   VsInit(Screen3);
  147.   VsInit(Screen4);
  148.   BuildAttrChart;
  149.   BuildMessages1;
  150.   MoveVsWindowBlock(Screen1, 1, 47, 11, 20,  (* Message 1             *)
  151.                     Screen3, 17, 63, 6, 15);
  152.   DisplayVs(Screen3);
  153.   MoveVsWindowBlock(Screen1, 1, 47, 1, 10,   (* Message 2             *)
  154.                     Screen3, 17, 63, 6, 15);
  155.   ReadLn;
  156.  
  157.  
  158.   DisplayVs(Screen3);                        (* Message 2             *)
  159.   BuildMessages2;
  160.   Screen4^ := Screen2^;
  161.   ClrVscrWindow(Screen4, 20, 67, 17, 24, $F);
  162.   WriteStringVs(Screen4, '* CENSORED *', false, 36, 21, $70);
  163.   Screen3^ := Screen4^;
  164.   MoveVsWindowBlock(Screen1, 1, 44, 1, 10,   (* Message 3             *)
  165.                     Screen3, 22, 65, 12, 21);
  166.   ReadLn;
  167.  
  168.  
  169.   DisplayVs(Screen3);                        (* Message 3             *)
  170.   Screen3^ := Screen4^;
  171.   MoveVsWindowBlock(Screen1, 1, 32, 11, 20,  (* Message 4             *)
  172.                     Screen3, 27, 58, 9, 18);
  173.   WriteStringVs(Screen3, '<--------', false, 18, 11, $7F);
  174.   ReadLn;
  175.  
  176.  
  177.   DisplayVs(Screen3);                        (* Message 4             *)
  178.   Screen3^ := Screen4^;
  179.   MoveVsWindowBlock(Screen1, 31, 63, 11, 20, (* Message 5             *)
  180.                     Screen3, 36, 68, 13, 22);
  181.   VSetVsXYattr(Screen3, 5, 65, 8, $7F);
  182.   VWriteStringVs(Screen3, '^||||||', 66, 8, $7F);
  183.   VSetVsXYattr(Screen3, 5, 67, 8, $7F);
  184.   ReadLn;
  185.  
  186.  
  187.   DisplayVs(Screen3);                         (* Message 5            *)
  188.   Screen3^ := Screen4^;
  189.   BuildMessages3;
  190.   MoveVsWindowBlock(Screen1, 1, 37, 1, 10,  (* Message 6              *)
  191.                     Screen3, 26, 62, 12, 21);
  192.   ReadLn;
  193.  
  194.  
  195.   DisplayVs(Screen3);                       (* Message 6              *)
  196.   Screen3^ := Screen2^;
  197.   WriteStringVs(Screen3, 'Press <ENTER> to turn the blink-bit off',
  198.                 false, 23, 3, $70);
  199.   ReadLn;
  200.  
  201.  
  202.   DisplayVs(Screen3);
  203.   WriteStringVs(Screen3, '   Press <ENTER> to quit demo-program    ',
  204.                 false, 22, 3, $70);
  205.   ReadLn;
  206.  
  207.  
  208.   DisplayVs(Screen3);
  209.   Blink(false);
  210.   ReadLn;
  211.  
  212.  
  213.   Blink(true);
  214.   ClrScr; NormVideo
  215. END.